home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / construc / UNIT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-29  |  4.4 KB  |  161 lines
  1. unit Unit1;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ExtCtrls, StdCtrls, Buttons, ComCtrls, MMSystem, broken, Menus;
  6.  
  7. type
  8.   TMainForm = class(TForm)
  9.     PageControl1: TPageControl;
  10.     TabSheet1: TTabSheet;
  11.     Panel1: TPanel;
  12.     EditURL: TEdit;
  13.     EditDepth: TEdit;
  14.     BitBtn1: TBitBtn;
  15.     BitBtn2: TBitBtn;
  16.     CheckBoxLocalDisk: TCheckBox;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     Label3: TLabel;
  20.     Label4: TLabel;
  21.     Splitter1: TSplitter;
  22.     ListBoxChecking: TListBox;
  23.     MemoChecked: TMemo;
  24.     TabSheet2: TTabSheet;
  25.     MemoSuspect: TMemo;
  26.     TabSheet3: TTabSheet;
  27.     MemoBroken: TMemo;
  28.     TabSheet4: TTabSheet;
  29.     MemoExternal: TMemo;
  30.     TabSheet5: TTabSheet;
  31.     MemoMailTo: TMemo;
  32.     TabSheet6: TTabSheet;
  33.     MemoNews: TMemo;
  34.     TabSheet7: TTabSheet;
  35.     MemoFTP: TMemo;
  36.     StatusBar1: TStatusBar;
  37.     BrokenLink1: TBrokenLink;
  38.     CheckBoxCGI: TCheckBox;
  39.     PopupMenuSuspected: TPopupMenu;
  40.     PopupMenuBrokenLinks: TPopupMenu;
  41.     PopupMenuExternalLinks: TPopupMenu;
  42.     PopupMenuMailTo: TPopupMenu;
  43.     PopupMenuNews: TPopupMenu;
  44.     PopupMenuFTP: TPopupMenu;
  45.     PopupMenuHomePage: TPopupMenu;
  46.     Save1: TMenuItem;
  47.     Save2: TMenuItem;
  48.     Save3: TMenuItem;
  49.     Save4: TMenuItem;
  50.     Save5: TMenuItem;
  51.     Save6: TMenuItem;
  52.     Save7: TMenuItem;
  53.     SaveDialog: TSaveDialog;
  54.     About1: TMenuItem;
  55.     About2: TMenuItem;
  56.     About3: TMenuItem;
  57.     About4: TMenuItem;
  58.     About5: TMenuItem;
  59.     About6: TMenuItem;
  60.     About7: TMenuItem;
  61.     procedure Splitter1Moved(Sender: TObject);
  62.     procedure BitBtn1Click(Sender: TObject);
  63.     procedure BitBtn2Click(Sender: TObject);
  64.     procedure BrokenLink1Update;
  65.     procedure SaveClick(Sender: TObject);
  66.     procedure AboutClick(Sender: TObject);
  67.   private
  68.     StartTime: LongInt;
  69.   end;
  70.  
  71. var
  72.   MainForm: TMainForm;
  73.  
  74. implementation
  75. {$R *.DFM}
  76.  
  77. procedure TMainForm.Splitter1Moved(Sender: TObject);
  78. begin
  79.   Label3.Left := Splitter1.Left + 7
  80. end;
  81.  
  82. procedure TMainForm.BitBtn1Click(Sender: TObject);
  83. var
  84.   Depth: Integer;
  85. begin
  86.   (Sender as TBitBtn).Enabled := False;
  87.   try
  88.     try
  89.       Depth := StrToInt(EditDepth.Text);
  90.     except
  91.       Depth := 0
  92.     end;
  93.     StartTime := timeGetTime;
  94.     if CheckBoxLocalDisk.Checked then
  95.       BrokenLink1.LCheckURL(EditURL.Text,Depth)
  96.     else
  97.       BrokenLink1.NCheckURL(EditURL.Text,CheckBoxCGI.Checked,Depth)
  98.   finally
  99.     (Sender as TBitBtn).Enabled := True
  100.   end
  101. end;
  102.  
  103. procedure TMainForm.BitBtn2Click(Sender: TObject);
  104. begin
  105.   BrokenLink1.Interrupted := True
  106. end;
  107.  
  108. procedure TMainForm.BrokenLink1Update;
  109. var
  110.   Min,Sec: LongInt;
  111. begin
  112.   ListBoxChecking.Items := BrokenLink1.Checking;
  113.   MemoChecked.Lines := BrokenLink1.Checked;
  114.   MemoSuspect.Lines := BrokenLink1.Suspect;
  115.   MemoBroken.Lines := BrokenLink1.Broken;
  116.   MemoExternal.Lines := BrokenLink1.HTTP;
  117.   MemoMailTo.Lines := BrokenLink1.MailTo;
  118.   MemoNews.Lines := BrokenLink1.News;
  119.   MemoFTP.Lines := BrokenLink1.FTP;
  120.   case BrokenLink1.Broken.Count of
  121.     0: StatusBar1.SimpleText := ' No broken links';
  122.     1: StatusBar1.SimpleText := ' One broken link';
  123.     else
  124.       StatusBar1.SimpleText := Format(' %d broken links',[BrokenLink1.Broken.Count]);
  125.   end;
  126.   if BrokenLink1.HTTP.Count > 0 then
  127.     StatusBar1.SimpleText := StatusBar1.SimpleText +
  128.       Format(' and %d external link(s)',[BrokenLink1.HTTP.Count]);
  129.   Sec := (timeGetTime - StartTime) div 1000;
  130.   Min := Sec div 60;
  131.   Sec := Sec mod 60;
  132.   StatusBar1.SimpleText := StatusBar1.SimpleText + Format(' in %d:%.2d.',[Min,Sec]);
  133.   Label3.Caption := Format('%d (Sub)pages checked:',[BrokenLink1.Checked.Count]);
  134.   Application.ProcessMessages
  135. end;
  136.  
  137. procedure TMainForm.SaveClick(Sender: TObject);
  138. begin
  139.   with SaveDialog do
  140.   begin
  141.     Title := (Sender AS TMenuItem).Hint;
  142.     if Execute then
  143.     case (Sender AS TComponent).Tag of
  144.       1: MemoChecked.Lines.SaveToFile(FileName);
  145.       2: MemoSuspect.Lines.SaveToFile(FileName);
  146.       3: MemoBroken.Lines.SaveToFile(FileName);
  147.       4: MemoExternal.Lines.SaveToFile(FileName);
  148.       5: MemoMailTo.Lines.SaveToFile(FileName);
  149.       6: MemoNews.Lines.SaveToFile(FileName);
  150.       7: MemoFTP.Lines.SaveToFile(FileName)
  151.     end
  152.   end
  153. end;
  154.  
  155. procedure TMainForm.AboutClick(Sender: TObject);
  156. begin
  157.   ShowMessage('InterBob 0.9 (c) 1997 by Bob Swart (aka Dr.Bob - www.drbob42.com)')
  158. end;
  159.  
  160. end.
  161.